home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / ANIMATE.PAS next >
Pascal/Delphi Source File  |  1991-10-09  |  5KB  |  214 lines

  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program Animate;
  10.  
  11. uses WinTypes, WinProcs, WObjects, Strings;
  12.  
  13. const
  14.   NumberLines = 20;
  15.  
  16. type
  17.   { Declare Record structure of a lines }
  18.   TLine = Record
  19.     X1, Y1, X2, Y2: Integer;
  20.     Color: LongInt;
  21.   end;
  22.  
  23.   { Create TDrawWindow, a TWindow decendant}
  24.   PDrawWindow = ^TDrawWindow;
  25.   TDrawWindow = object(TWindow)
  26.     MaxX: Integer;
  27.     MaxY: Integer;
  28.     DX1, DY1, DX2, DY2: Integer;
  29.     LastLine: Integer;
  30.     Lines: array[1..NumberLines] of TLine;
  31.     procedure DrawLine(DC: HDC; Index: Integer; Draw: Boolean);
  32.     procedure GetWindowClass(var WndClass: TWndClass); virtual;
  33.     procedure Next(var A, DA, Max: Integer);
  34.     procedure NextLine;
  35.     procedure WMRight(var Msg: TMessage); virtual WM_RButtonDown;
  36.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  37.     procedure SetUpWindow; virtual;
  38.     procedure wmSize(var Message: TMessage);
  39.       virtual wm_Size;
  40.   end;
  41.  
  42.   { TApp, a decendant of TApplication calls the Idle method
  43.     from the main message loop }
  44.   TApp = object(TApplication)
  45.     procedure Idle; virtual;
  46.     procedure InitMainWindow; virtual;
  47.     procedure MessageLoop; virtual;
  48.   end;
  49.  
  50. { Drawline draws a line with the given color }
  51. procedure TDrawWindow.DrawLine(DC: HDC; Index: Integer; Draw: Boolean);
  52. var
  53.   MadeDC: Boolean;
  54.   Pen: HPen;
  55. begin
  56.   MadeDC := DC = 0;
  57.   if MadeDC then
  58.     DC := GetDC(HWindow);
  59.   with Lines[Index] do
  60.   begin
  61.     if Draw then
  62.       Pen := SelectObject(DC, CreatePen(ps_Solid, 1, Lines[Index].Color))
  63.     else
  64.       Pen := SelectObject(DC, CreatePen(ps_Solid, 1, 0));
  65.     MoveTo(DC, X1, Y1);
  66.     LineTo(DC, X2, Y2);
  67.   end;
  68.   DeleteObject(SelectObject(DC, Pen));
  69.   if MadeDC then
  70.     ReleaseDC(HWindow, DC);
  71. end;
  72.  
  73. procedure TDrawWindow.WMRight(var Msg: TMessage);
  74. begin
  75.   messagebox(hWindow,'asd','asdf',mb_ok);
  76. end;
  77. { Set background to black }
  78. procedure TDrawWindow.GetWindowClass(var WndClass: TWndClass);
  79. begin
  80.   TWindow.GetWindowClass(WndClass);
  81.   WndClass.HIcon := 0;
  82.   WndClass.hbrBackGround := GetStockObject(Black_Brush);
  83. end;
  84.  
  85. { Increment the data structure }
  86. procedure TDrawWindow.Next(var A, DA, Max: Integer);
  87. begin
  88.   Inc(A, DA);
  89.   if A > Max then
  90.   begin
  91.     A := Max;
  92.     DA := ((-1 - Random(3)) * 2);
  93.   end
  94.   else if A < 0 then
  95.   begin
  96.     A := 0;
  97.     DA := (Random(3) + 1) * 2;
  98.   end;
  99. end;
  100.  
  101. { Add next line }
  102. procedure TDrawWindow.NextLine;
  103. begin
  104.   DrawLine(0, LastLine, False);
  105.   if LastLine <> 1 then
  106.     Lines[LastLine] := Lines[LastLine - 1]
  107.   else
  108.     Lines[LastLine] := Lines[NumberLines];
  109.   with Lines[LastLine] do
  110.   begin
  111.     Next(X1, DX1, MaxX);
  112.     Next(X2, DX2, MaxX);
  113.     Next(Y1, DY1, MaxY);
  114.     Next(Y2, DY2, MaxY);
  115.     Color := RGB(Random(255), Random(255), Random(255));
  116.   end;
  117.   DrawLine(0, LastLine, True);
  118.   Inc(LastLine);
  119.   if LastLine > NumberLines then
  120.     LastLine := 1;
  121. end;
  122.  
  123. { Update the window and call DrawLine}
  124. procedure TDrawWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  125. var
  126.   Index, I: Integer;
  127. begin
  128.   Index := LastLine;
  129.   I := 0;
  130.   while I < NumberLines do
  131.   begin
  132.     DrawLine(PaintDC, Index, True);
  133.     Inc(Index);
  134.     if Index > NumberLines then
  135.       Index := 1;
  136.     Inc(I);
  137.   end;
  138. end;
  139.  
  140. { Initialize Random Values }
  141. procedure TDrawWindow.SetUpWindow;
  142. var
  143.   I: Integer;
  144. begin
  145.   TWindow.SetUpWindow;
  146.   Randomize;
  147.   DX1 := (Random(3) + 1) * 2;
  148.   DY1 := (Random(3) + 1) * 2;
  149.   DX2 := (Random(3) + 1) * 2;
  150.   DY1 := (Random(3) + 1) * 2;
  151.   FillChar(Lines, SizeOf(Lines), 0);
  152.   LastLine := 1;
  153.   with Lines[NumberLines] do
  154.   begin
  155.     X1 := Random(100);
  156.     Y1 := Random(100);
  157.     X2 := Random(100);
  158.     Y2 := Random(100);
  159.     Color := 0;
  160.   end;
  161. end;
  162.  
  163. { Store object values with current window size }
  164. procedure TDrawWindow.wmSize(var Message: TMessage);
  165. begin
  166.   MaxX := integer(Message.lParamLo);
  167.   MaxY := integer(Message.lParamHi);
  168. end;
  169.  
  170. { While message loop is not processing, draw lines }
  171. procedure TApp.Idle;
  172. begin
  173.   PDrawWindow(MainWindow)^.NextLine;
  174. end;
  175.  
  176. { Initialize MainWindow with a title }
  177. procedure TApp.InitMainWindow;
  178. begin
  179.   MainWindow := New(PDrawWindow, Init(Nil, 'Animate Window'));
  180. end;
  181.  
  182. { Add Idle loop to main message loop.}
  183. procedure TApp.MessageLoop;
  184. var
  185.   Message: TMsg;
  186. begin
  187.   while True do
  188.   begin
  189.     if PeekMessage(Message, 0, 0, 0, pm_Remove) then
  190.     begin
  191.       if Message.Message = wm_Quit then
  192.       begin
  193.         Status := Message.WParam;
  194.         Exit;
  195.       end;
  196.       if not ProcessAppMsg(Message) then
  197.       begin
  198.         TranslateMessage(Message);
  199.         DispatchMessage(Message);
  200.       end;
  201.     end
  202.     else
  203.       Idle;
  204.   end;
  205. end;
  206.  
  207. var
  208.   App: TApp;
  209. begin
  210.   App.Init('Animate');
  211.   App.Run;
  212.   App.Done;
  213. end.
  214.